require(fpc)

source("commonmethods.R")

get.sampleRuspini <- function() {
	d<-ruspini
	set.seed(43);
	rp<-pam(ruspini,4)$clustering
	list(d=d,rp=rp,name="Ruspini")
}

get.sampleHorseShoes<-function(n=300) {
	set.seed(100)
	segmentsCount=6
	countPerSegment=n/segmentsCount
	lin<-function(x1,x2,y1,y2) matrix(c(runif(countPerSegment,x1,x2),runif(countPerSegment,y1,y2)), countPerSegment,2)
	d<-rbind(lin(0,8,10,11),lin(0,8,4,5),lin(0,1,4,10),  lin(2.5,10,1,2),lin(2.5,10,7.5,8.5),lin(9,10,2,8))
	colnames(d)=c("X","Y")
	rp<-dbscan(d,1.0)$cluster
	list(d=d,rp=rp,name="2_Hufeisen")
}


get.sampleZigarre <- function(n=300) {
	x <- runif(n,-1,1)
	y <- ifelse(runif(n)>.5,-.1,.1) + .02*rnorm(n)
	d <- matrix(c(x,y),n,2)
	colnames(d)<-c("X","Y")
	rp<- ifelse(y<=0,1,2)
	list(d=d,rp=rp,name="2_Zigarren")
}


get.sampleTwoCircles <- function (n=300, p=.7) {
  set.seed(42)
  x1 <- rnorm(n)
  y1 <- rnorm(n)
  r2 <- 7+rnorm(n)
  t2 <- runif(n,0,2*pi)
  x2 <- r2*cos(t2)
  y2 <- r2*sin(t2)
  r  <- runif(n)>p
  x  <- ifelse(r,x1,x2)
  y  <- ifelse(r,y1,y2)
  d  = matrix(c(x, y),n,2)
  colnames(d)<-c("X","Y")
  rp<-dbscan(d,2.0)$cluster
  list(d=d,rp=rp,name="2_Kreise")
}


get.sampleFiveCenters <- function(n=250) {
	set.seed(42)
	c=5
	ms<-matrix(c(c(8,7)
				,c(0,0)
				,c(-5,-5)
				,c(-7,6)
				,c(10,-11))
			  ,c,2,byrow=TRUE)
	sz<-matrix(
		c(4,0.7
	 	,0.5,1.5
	 	,1,1
		 ,1,3
		 ,5,1.8)
		,c,2,byrow=TRUE)

	set.seed(42)
	i = 1
	d<-cbind(rnorm(n/c,ms[i,1],sz[i,1])
			,rnorm(n/c,ms[i,2],sz[i,2])) 
	for(i in 2:c) { 
		d<-rbind(d , cbind(rnorm(n/c,ms[i,1],sz[i,1])
						  ,rnorm(n/c,ms[i,2],sz[i,2])))
	}
	colnames(d) <- c("X", "Y")

	rp<-dbscan(d,3.1)$cluster
  	list(d=d,rp=rp,name="5_Zentren")
}

get.sampleUniform <- function(n=200) {
	set.seed(42)
	d<-matrix(runif(n*2, min=0, max=10),n,2);
	colnames(d)<-c("X","Y");
	rp<-rep(1,n)
	list(d=d,rp=rp,name="Gleichverteilt")
}

#----------------------------------------------------------------------------------------------
# fMRI Datasets
get.sampleStroop<- function(n=NULL) {
	drp<-read.table("~/Documents/Diplom/arbeit/testdata/clustered-stroop.txt")
	d1=drp[,1:3]
	rp1=drp[,4]
	
	# remove points ?
	if(is.null(n)||(length(d1[,1])<n)) {
		d=d1
		rp=rp1
	} else {
		d=d1[1:n,]
		rp=rp1[1:n,]
	}
	colnames(d)<-c("X","Y","Z")
	list(d=d,rp=(rp),name="Stroop")
}

get.sampleErrAwareness<- function(n=NULL) {
	drp<-read.table("~/Documents/Diplom/arbeit/testdata/clustered-err-awareness.txt")
	d1=drp[,1:3]
	rp1=drp[,4]
	
	# remove points ?
	if(is.null(n)||(length(d1[,1])<n)) {
		d=d1
		rp=rp1
	} else {
		d=d1[1:n,]
		rp=rp1[1:n,]
	}
	colnames(d)<-c("X","Y","Z")
	list(d=d,rp=(rp),name="Klein2007")
}

get.sampleSelfrel<- function(n=NULL) {
	drp<-read.table("~/Documents/Diplom/arbeit/testdata/clustered-selfrel-prozess.txt")
	d1=drp[,1:3]
	rp1=drp[,4]
	
	# remove points ?
	if(is.null(n)||(length(d1[,1])<n)) {
		d=d1
		rp=rp1
	} else {
		d=d1[1:n,]
		rp=rp1[1:n,]
	}
	
	#------ remove small cluster with one point
	
	# calculate frequence of cluster
	allClusterNrs=unique(sort(rp));
	clusterNrFreq=vector(length=max(allClusterNrs)); 
	for(c in allClusterNrs) clusterNrFreq[c]=length(rp[rp==c]);
	
	# collect all one point cluster members
	smallIxs=which(rp %in% which(clusterNrFreq==1))
	# ixs of point with not belogn to one point clusters
	ixs=setdiff(1:length(rp), smallIxs)

	#assure equal length
	stopifnot(nrow(d)==length(rp))
	
	colnames(d)<-c("X","Y","Z")
	list(d=d[ixs,],rp=rp[ixs],name="Unveröffentlicht")
}

get.sampleSelfrelLong<- function(n=NULL) {
	drp<-read.table("~/Documents/Diplom/arbeit/testdata/selfrel-prozess-by-studie.txt")
	d1=drp[,1:3]
	#rp1=drp[,4]
	
	# remove points ?
	if(is.null(n)||(length(d1[,1])<n)) {
		d=d1
	#	rp=rp1
	} else {
		d=d1[1:n,]
		rp=rp1[1:n,]
	}
	colnames(d)<-c("X","Y","Z")
	list(d=d,rp=rep(1,nrow(d)),name="Unveröffentlicht_Lang")
}

samples=list( get.sampleRuspini()
			, get.sampleFiveCenters()
			, get.sampleZigarre()
			, get.sampleHorseShoes()
			, get.sampleTwoCircles() 
			, get.sampleUniform()
			# fMRI
			# , get.sampleStroop()
			# , get.sampleErrAwareness()
			# , get.sampleSelfrel()
			);
